home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / os2 / kzr0597.zip / SQRT.CMD < prev    next >
OS/2 REXX Batch file  |  1997-02-06  |  3KB  |  108 lines
  1. /* REXX-Programm sqrt.CMD */
  2.  
  3.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  4.    Call SysLoadFuncs
  5.    signal on syntax name sqrtMsg
  6.  
  7. /* Diese Variablen müssen für jede Prozedur definiert werden, damit die  */
  8. /* Prozedur die Variable bufND kennt und die Variable ND übernehmen kann.*/
  9.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  10.    lp=LastPos("\", Pfd)
  11.    Pfd=DelStr(Pfd, 1+lp)
  12.    bufND =Pfd||"NDZahl.DAT"
  13.    bufMsg=Pfd||"Meldung.DAT"
  14.    ND = LineIn(bufND, 1)
  15.  
  16. /* An dieser Stelle muß  "bufMsg"  gelöscht werden, damit dann,   */
  17. /* die Datei  "Meldung.DAT"  leer ist, diese auch leer bleibt.    */
  18.    call charout(bufMsg)
  19.    Call SysFileDelete bufMsg
  20.  
  21.    parse arg x,y
  22.    p0p=x*x /* Diese Anweisung prvoziert eine Syntax-Fehlermeldung */
  23.  
  24.    if length(y) > 0 then
  25.    do
  26.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  27.   /*  damit in den diesbezüglichen temporären Dateien                      */
  28.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  29.      ret=LineOut(bufMsg, "Im Argument von  sqrt(...)  ist mindestens  1  nicht zulässiges Komma !")
  30.      EXIT
  31.    end
  32.  
  33.    if (x=0) then return(0)
  34.    if (x=1) then return(1)
  35.  
  36.    if (x<0) then
  37.    do
  38.      /* An dieser Stelle muß  "bufMsg"  gelöscht werden, damit Meldungen   */
  39.      /* nicht aneinandergehängt werden.                                    */
  40.      call charout(bufMsg)
  41.      Call SysFileDelete bufMsg
  42.      ret=LineOut(bufMsg, "Die zweite Wurzel aus " x"  ist eine komplexe Zahl !")
  43.      EXIT
  44.    end
  45.  
  46.    if x < 1.0E-10000 | x > 1.0E+10000 then
  47.    do
  48.      /* An dieser Stelle muß  "bufMsg"  gelöscht werden, damit Meldungen   */
  49.      /* nicht aneinandergehängt werden.                                    */
  50.      call charout(bufMsg)
  51.      Call SysFileDelete bufMsg
  52.      call charout(bufND)
  53.      Call SysFileDelete bufND
  54.      ret=LineOut(bufMsg, "     Das Argument der Funktion sqrt(...)",
  55.                          "                                           ",
  56.                          "sollte entweder gleich  0                                                      ",
  57.                          "oder größer als  1.0E-10000  und kleiner als  1.0E+10000  sein.")
  58.      EXIT
  59.    end
  60.  
  61.    NUMERIC DIGITS ND+12
  62.  
  63.    if x<1 then SIGNAL A
  64.    else
  65.    do
  66.      n=0
  67.      do while x>100
  68.        x=x/100
  69.        n=n+1
  70.      end
  71.    end
  72.    SIGNAL B
  73.  
  74.    A:
  75.      n=0
  76.      do while x<(0.01)
  77.        x=x*100
  78.        n=n-1
  79.      end
  80.      SIGNAL B
  81.  
  82.    B:
  83.      y=1
  84.      t=x/y
  85.      do while abs(y-t) > y*10**(-ND-7)
  86.        y=(y+t)/2
  87.        t=x/y
  88.      end
  89.  
  90.    u=y*10**n
  91.    numeric digits ND
  92.    return(Format(u))
  93.  
  94.  
  95. sqrtMsg:
  96.    sf=ErrorText(RC)
  97.    if  Pos("Bad arithmetic conversion", sf) > 0 then
  98.    do
  99.      /* An dieser Stelle muß  "bufMsg"  gelöscht werden, damit Meldungen   */
  100.      /* nicht aneinandergehängt werden.                                    */
  101.      call charout(bufMsg)
  102.      Call SysFileDelete bufMsg
  103.      call charout(bufND)
  104.      Call SysFileDelete bufND
  105.      ret=LineOut(bufMsg, "Sie haben in  sqrt(...)  kein gültiges Argument eingegeben !")
  106.    end
  107.  
  108.